
:- use_module(library(lists)).
:- use_module(library(assoc)).
:- use_module(library(http/json)).

:- [gf].

null(?).

%% context(Context, Type, Metas, Leaves, NestedTree, PathedTree, Tree, FlatTree)
:- dynamic context/8.

compile(MaxDepth, MaxFuns, MaxUnknown) :-
        compile_contexts(MaxDepth, MaxFuns, MaxUnknown).

%% json_database.

json_database :-
        json_database(0).

json_database(Width) :-
        null(Null),

        %% This is calculated directly in Javascript instead:
        %% build_replacement_dict(ReplacementDict),
        %% atom_json_term(ReplacementJSON, ReplacementDict, [as(atom), width(Width), null(Null)]),
        %% format('var REPLACEMENTS = ~p;\n\n', [ReplacementJSON]),

        build_context_dict(ContextDict),
        atom_json_term(ContextJSON, ContextDict, [as(atom), width(Width), null(Null)]),
        format('var CONTEXTS = ~p;\n\n', [ContextJSON]).

build_replacement_dict(json(TreeDict)) :-
        findall(StrTree=Context,
                ( context_tree(Context, Tree),
                  with_output_to(atom(StrTree), print_gftree(Tree))
                ), TreeDict).

build_context_dict(json(ContextDict)) :-
        setof(Context=TreeGroup,
              setof(JSTree, 
                    Tree^( context_tree(Context, Tree),
                           json_tree(Tree, JSTree)
                         ), TreeGroup),
              ContextDict).

context_tree(Context, NestedTree) :-
        context(Context, _Type, _Metas, _Leaves, NestedTree, _PathedTree, _Tree, _FlatTree).

print_gftree(Tree) :-
        tree(Tree, Fun, Type, Children),
        format('(~w:~w', [Fun, Type]),
        ( member(Child, Children),
          write(' '), print_gftree(Child),
          fail
        ; write(')')
        ).

json_tree(Tree, json(JSTree)) :-
        tree(Tree, Fun, Type, Children),
        ( null(Fun) ->
          JSTree = [type=Type]
        ;
          JSTree = [node=Fun, type=Type, children=JSChildren],
          maplist(json_tree, Children, JSChildren)
        ).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

flatten_tree(Tree, Flattree) :- 
        flatten_tree(Tree, Flattree, []).

flatten_tree(Tree) -->
        {tree(Tree, Node, Type, Children)},
        [Node:Type],
        flatten_children(Children).

flatten_children([]) --> [].
flatten_children([Child|Children]) --> flatten_tree(Child), flatten_children(Children).


unflatten_tree(Flattree, Tree) :-
        unflatten_tree(Tree, Flattree, []).

unflatten_tree(Tree) -->
        {tree(Tree, Node, Type, Children)},
        [Node:Type],
        {null(Node) -> Childtypes = [] ; fun(Node, Type, Childtypes)},
        unflatten_children(Childtypes, Children).

unflatten_children([], []) --> [].
unflatten_children([_|Types], [Child|Children]) --> unflatten_tree(Child), unflatten_children(Types, Children).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% similar(Tree, Similar, Distance) :-
%         metatree(Type, Metas, Tree),
%         metatree(Type, Metas, Similar),
%         edit_distance(Tree, Similar, Distance).

% levenshtein(As, Bs, Dist, Matrix) :-
%         lev_init(Bs, Ds, 0, Dist0),
%         lev_outer_loop(As, Bs, Ds, Dist0, Dist, Matrix, 0).

% lev_init([], [], D, D).
% lev_init([_|Bs], [D1|Ds], D0, D) :-
%         D1 is D0+1,
%         lev_init(Bs, Ds, D1, D).

% lev_outer_loop([], _, _, Dist, Dist, [], _).
% lev_outer_loop([A|As], Bs, Ds0, _, Dist, [Ds|Matrix], J0) :-
%         J is J0+1,
%         lev_inner_loop(Bs, A, [J0|Ds0], J, Dist0, Ds),
%         lev_outer_loop(As, Bs, Ds, Dist0, Dist, Matrix, J).

% lev_inner_loop([], _, _, Dist, Dist, []).
% lev_inner_loop([B|Bs], A, [D00,D01|Ds0], D10, Dist, [D11|Ds1]) :-
%         ( A == B -> D11 = D00
%         ; D11 is 1 + min(D00, min(D01, D10))
%         ),
%         lev_inner_loop(Bs, A, [D01|Ds0], D11, Dist, Ds1).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

compile_contexts(MaxDepth, MaxFuns, MaxUnknown) :-
        retractall(context(_,_,_,_,_,_,_,_)),
        type(Type),
        format('\n* ~w\n', [Type]),
        generate_tree(Type, NestedTree, PathedTree, MaxDepth, MaxFuns, MaxUnknown),
        maplist(remove_path, PathedTree, Tree),
        maplist(strip_treenode, Tree, FlatTree),
        include(is_leaf, PathedTree, Leaves),
        extract_metas(Tree, Metas),
        create_context(Type, Metas, Context),
        ( context(Context, _, _, _, _, _, _, _) -> true
        ; write({Context}), nl
        ),
        assert(context(Context, Type, Metas, Leaves, NestedTree, PathedTree, Tree, FlatTree)),
        fail ; true.

remove_path(Node/_Path, Node).

strip_treenode(Node:Type, Value) :-
        null(Node) -> Value = Type ; Value = Node.

is_leaf((Node:Type)/_) :- null(Node) ; fun(Node, Type, []).

extract_metas(Tree, Metas) :-
        null(Null),
        findall(Type, member(Null:Type, Tree), Metas).

create_context(Type, Metas, Context) :-
        atomic_list_concat([Type|Metas], ':', Context).

focus(Flattree, Focus) :-
        unflatten_tree(Flattree, Tree),
        nodepath(Tree, Focus).

nodepath(Tree, []) :-
        children(Tree, []).
nodepath(Tree, [N|Path]) :-
        child(N, Tree, Child),
        nodepath(Child, Path).


%% generate_tree(+Type, ?Tree, ?Flattened, +MaxDepth, +MaxFuns, +MaxMetas)
generate_tree(Type, Tree, Nodes, MaxDepth, MaxFuns, MaxMetas) :-
        s_term(SMaxDepth, MaxDepth), s_term(SMaxFuns, MaxFuns), s_term(SMaxMetas, MaxMetas),
        generate_tree(Type, Tree, [], SMaxDepth, SMaxFuns-_, SMaxMetas-_, Nodes, []).

%% generate_tree(+Type, ?Tree, +Path, +Depth, +Funs-?Funs, +Metas-?Metas) // ?FlattenedTree
generate_tree(Type, Tree, Path, _, MF-MF, s(MM)-MM) -->
        {null(Null), tree(Tree, Null, Type, [])},
        [(Null:Type)/Path].
generate_tree(Type, Tree, Path, s(MD), s(MF0)-MF, MM0-MM) -->
        {tree(Tree, Fun, Type, Children),
         fun(Fun, Type, Childtypes)},
        [(Fun:Type)/Path],
        generate_children(Childtypes, Children, Path+0, MD, MF0-MF, MM0-MM).

generate_children([], [], _, _, MF-MF, MM-MM) --> [].
generate_children([Type|Types], [Tree|Trees], Path+N, MD, MF0-MF, MM0-MM) -->
        {append(Path, [N], PathN), N1 is N+1},
        generate_tree(Type, Tree, PathN, MD, MF0-MF1, MM0-MM1),
        generate_children(Types, Trees, Path+N1, MD, MF1-MF, MM1-MM).


s_term(z, 0).
s_term(s(T), N) :-
        ( var(N) ->
          s_term(T, N0),
          N is N0 + 1
        ; var(T) ->
          N > 0,
          N0 is N - 1,
          s_term(T, N0)
        ).


